home *** CD-ROM | disk | FTP | other *** search
/ The Game Master (3rd Edition) / The Game Master 3rd edition.iso / files / demo_vga / demoega1 / walpaper.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1986-08-20  |  18.0 KB  |  625 lines
  1. PROGRAM walpaper;
  2.  
  3.   {$I graph.p}
  4.  
  5. TYPE
  6.   picrec = ARRAY[1..17000] OF Char;
  7.   filename = STRING[12];
  8.  
  9. VAR
  10.   parmchoice, reschoice, choice : Char;
  11.   corna, cornb, side, ci, cj, cc, cp, pp,
  12.   setter, color, cz, s, xp, yp : Integer;
  13.   i, k, num, a, b, c, xx, yy, x, y, z : Real;
  14.   savefilename, showfilename : filename;
  15.   savefile, showfile : FILE OF picrec;
  16.   runc, wait, okay, parms, highres : Boolean;
  17.   picture, picturesave, pictureshow : picrec;
  18.  
  19.   PROCEDURE filecheck(VAR filetocheck : filename);
  20.     {check for file's existance, returns okay true
  21.     if file exists}
  22.   VAR
  23.     ckfile : Text;            {defines file as variable for use by filecheck}
  24.   BEGIN
  25.     Assign(ckfile, filetocheck);
  26.     {$I-} Reset(ckfile) {$I+} ;
  27.     okay := (IOResult = 0);
  28.     IF okay THEN Close(ckfile);
  29.   END;
  30.  
  31.   PROCEDURE Low;
  32.   BEGIN
  33.     GraphColorMode;
  34.     Palette(color);
  35.   END;
  36.  
  37.   PROCEDURE High;
  38.   BEGIN
  39.     HiRes;
  40.     HiResColor(color);
  41.   END;
  42.  
  43.   PROCEDURE Setcolor;
  44.   BEGIN
  45.     ClrScr;
  46.     IF highres THEN BEGIN
  47.       TextMode(C80);
  48.       GoToXY(10, 5);
  49.       Write('In High resolution only one color may be chosen from below');
  50.       GoToXY(10, 6); Write('        the background color will always be black');
  51.       GoToXY(1, 9); TextColor(15); Write('0  . . . . . Black (useless)');
  52.       GoToXY(1, 10); TextColor(1); Write('1  . . . . . Blue');
  53.       GoToXY(1, 11); TextColor(2); Write('2  . . . . . Green');
  54.       GoToXY(1, 12); TextColor(3); Write('3  . . . . . Cyan');
  55.       GoToXY(1, 13); TextColor(4); Write('4  . . . . . Red');
  56.       GoToXY(1, 14); TextColor(5); Write('5  . . . . . Magenta');
  57.       GoToXY(1, 15); TextColor(6); Write('6  . . . . . Brown');
  58.       GoToXY(1, 16); TextColor(7); Write('7  . . . . . Light Gray');
  59.       GoToXY(40, 9); TextColor(8); Write('8  . . . . . Dark Gray');
  60.       GoToXY(40, 10); TextColor(9); Write('9  . . . . . Light Blue');
  61.       GoToXY(40, 11); TextColor(10); Write('10  . . . . . Light Green');
  62.       GoToXY(40, 12); TextColor(11); Write('11  . . . . . Light Cyan');
  63.       GoToXY(40, 13); TextColor(12); Write('12  . . . . . Light Red');
  64.       GoToXY(40, 14); TextColor(13); Write('13  . . . . . Light Magenta');
  65.       GoToXY(40, 15); TextColor(14); Write('14  . . . . . Yellow');
  66.       GoToXY(40, 16); TextColor(15); Write('15  . . . . . White');
  67.       GoToXY(1, 18); TextColor(3); Write('Choose a color: ');
  68.       ReadLn(color);
  69.     END;
  70.     IF NOT(highres) THEN BEGIN
  71.       TextMode(C80);
  72.       GoToXY(10, 5);
  73.       WriteLn('In Low resolution mode you have 4 combinations of colors, any of');
  74.       GoToXY(10, 6);
  75.       WriteLn('            of the 4 combinations may be chosen');
  76.       GoToXY(1, 9); Write(' # ');
  77.       GoToXY(5, 9); Write(' background ');
  78.       GoToXY(25, 9); Write(' color 1 ');
  79.       GoToXY(45, 9); Write(' color 2 ');
  80.       GoToXY(65, 9); Write(' color 3 ');
  81.       GoToXY(1, 10); TextColor(3); Write(' 0 ');
  82.       GoToXY(5, 10); TextColor(0); Write(' background ');
  83.       GoToXY(25, 10); TextColor(2); Write(' green ');
  84.       GoToXY(45, 10); TextColor(4); Write(' red ');
  85.       GoToXY(65, 10); TextColor(6); Write(' brown ');
  86.       GoToXY(1, 11); TextColor(3); Write(' 1 ');
  87.       GoToXY(5, 11); TextColor(0); Write(' background ');
  88.       GoToXY(25, 11); TextColor(3); Write(' cyan ');
  89.       GoToXY(45, 11); TextColor(5); Write(' magenta ');
  90.       GoToXY(65, 11); TextColor(7); Write(' light gray ');
  91.       GoToXY(1, 12); TextColor(3); Write(' 2 ');
  92.       GoToXY(5, 12); TextColor(0); Write(' background ');
  93.       GoToXY(25, 12); TextColor(10); Write(' light green ');
  94.       GoToXY(45, 12); TextColor(12); Write(' light red ');
  95.       GoToXY(65, 12); TextColor(14); Write(' yellow ');
  96.       GoToXY(1, 13); TextColor(3); Write(' 3 ');
  97.       GoToXY(5, 13); TextColor(0); Write(' background ');
  98.       GoToXY(25, 13); TextColor(11); Write(' light cyan ');
  99.       GoToXY(45, 13); TextColor(13); Write(' light magenta ');
  100.       GoToXY(65, 13); TextColor(15); Write(' white ');
  101.       GoToXY(1, 18); TextColor(3); Write('Choose a color combination: (0,1,2,3)  ');
  102.       ReadLn(color);
  103.     END;
  104.   END;
  105.  
  106.   PROCEDURE setparms;
  107.   BEGIN
  108.     WriteLn('Do you want the parameters displayed in the picture? (Y/N)');
  109.     Read(Kbd, parmchoice);
  110.     IF UpCase(parmchoice) = 'Y' THEN parms := True ELSE parms := False;
  111.   END;
  112.  
  113.   PROCEDURE Setresolution;
  114.   BEGIN
  115.     WriteLn('Low res or High res graphics ? (H/L) ');
  116.     Read(Kbd, reschoice);
  117.     IF UpCase(reschoice) = 'H' THEN highres := True ELSE highres := False;
  118.   END;
  119.  
  120.   PROCEDURE snapshot;
  121.   BEGIN
  122.     GetPic(picture, 0, 0, 639, 199);
  123.   END;
  124.  
  125.   PROCEDURE Project;
  126.   BEGIN
  127.     IF highres THEN High ELSE Low;
  128.     PutPic(picture, 0, 199);
  129.   END;
  130.  
  131.   PROCEDURE Connetta;
  132.   BEGIN
  133.     REPEAT
  134.       GoToXY(1, 20); ClrEol;
  135.       Write('Value for corna ? ');
  136.       {$I-} ReadLn(corna) {$I+} ;
  137.       okay := (IOResult = 0);
  138.       IF (-10000 > corna) OR (corna > 10000) THEN okay := False;
  139.     UNTIL okay;
  140.   END;
  141.  
  142.   PROCEDURE Connettb;
  143.   BEGIN
  144.     REPEAT
  145.       GoToXY(1, 21); ClrEol;
  146.       Write('Value for cornb ? ');
  147.       {$I-} ReadLn(cornb) {$I+} ;
  148.       okay := (IOResult = 0);
  149.       IF (-10000 > cornb) OR (cornb > 10000) THEN okay := False;
  150.     UNTIL okay;
  151.   END;
  152.  
  153.   PROCEDURE Connettside;
  154.   BEGIN
  155.     REPEAT
  156.       GoToXY(1, 22); ClrEol;
  157.       Write('Value for side ? ');
  158.       {$I-} ReadLn(side) {$I+} ;
  159.       okay := (IOResult = 0);
  160.       IF (-10000 > side) OR (side > 10000) THEN okay := False;
  161.     UNTIL okay;
  162.   END;
  163.  
  164.   PROCEDURE Inmartin1num;
  165.   BEGIN
  166.     REPEAT
  167.       okay := True;
  168.       GoToXY(1, 19); ClrEol;
  169.       Write('Number of iterations to run ? ');
  170.       ReadLn(num);
  171.     UNTIL okay;
  172.   END;
  173.  
  174.   PROCEDURE Inputmartin1a;
  175.   BEGIN
  176.     REPEAT
  177.       GoToXY(1, 20); ClrEol;
  178.       Write('Value for a ? ');
  179.       {$I-} ReadLn(a) {$I+} ;
  180.       okay := (IOResult = 0);
  181.       IF (-10000 > a) OR (a > 10000) THEN okay := False;
  182.     UNTIL okay;
  183.   END;
  184.  
  185.   PROCEDURE Inputmartin1b;
  186.   BEGIN
  187.     REPEAT
  188.       GoToXY(1, 21); ClrEol;
  189.       Write('Value for b ? ');
  190.       {$I-} ReadLn(b) {$I+} ;
  191.       okay := (IOResult = 0);
  192.       IF (-10000 > b) OR (b > 10000) THEN okay := False;
  193.     UNTIL okay;
  194.   END;
  195.  
  196.   PROCEDURE Inputmartin1c;
  197.   BEGIN
  198.     REPEAT
  199.       GoToXY(1, 22); ClrEol;
  200.       Write('Value for c ? ');
  201.       {$I-} ReadLn(c) {$I+} ;
  202.       okay := (IOResult = 0);
  203.       IF (-10000 > c) OR (c > 10000) THEN okay := False;
  204.     UNTIL okay;
  205.   END;
  206.  
  207.   PROCEDURE fileit;
  208.   VAR
  209.     filechoice : Char;
  210.     doit : Boolean;
  211.   BEGIN
  212.     picturesave := picture;
  213.     REPEAT
  214.       doit := True;
  215.       GoToXY(1, 1); Write('                                       ');
  216.       GoToXY(1, 1);
  217.       Write('input filename: '); ReadLn(savefilename);
  218.       IF savefilename <> '' THEN BEGIN
  219.         filecheck(savefilename);
  220.         IF okay THEN doit := False ELSE doit := True;
  221.         IF doit = False THEN BEGIN
  222.           GoToXY(1, 2); Write('File exists -- overwrite? (Y/N)');
  223.           Read(Kbd, filechoice);
  224.           IF UpCase(filechoice) = 'Y' THEN doit := True ELSE doit := False;
  225.           GoToXY(1, 2); Write('                               ');
  226.         END;
  227.       END;
  228.     UNTIL doit;
  229.     IF savefilename <> '' THEN BEGIN
  230.       GoToXY(1, 2);
  231.       Write('Saving file                           ');
  232.       Assign(savefile, savefilename);
  233.       Rewrite(savefile);
  234.       Write(savefile, picturesave);
  235.       Flush(savefile);
  236.       Close(savefile);
  237.     END;
  238.   END;
  239.  
  240.   PROCEDURE showit;
  241.   VAR
  242.     doit : Boolean;
  243.   BEGIN
  244.     REPEAT
  245.       GoToXY(1, 20); ClrEol;
  246.       Write('input filename: '); ReadLn(showfilename);
  247.       IF showfilename <> '' THEN BEGIN
  248.         Filecheck(showfilename);
  249.         IF NOT(okay) THEN doit := False ELSE doit := True;
  250.         IF NOT(doit) THEN BEGIN
  251.           GoToXY(1, 21);
  252.           Write('File does not exist');
  253.         END;
  254.       END;
  255.     UNTIL doit;
  256.     IF showfilename <> '' THEN BEGIN
  257.       Assign(showfile, showfilename);
  258.       Reset(showfile);
  259.       Read(showfile, pictureshow);
  260.       picture := pictureshow;
  261.       Close(showfile);
  262.       IF Chr(1) = picture[1] THEN highres := True ELSE highres := False;
  263.       Setcolor;
  264.       Project;
  265.       REPEAT UNTIL KeyPressed;
  266.     END;
  267.   END;
  268.  
  269.   PROCEDURE Endconnettdecision;
  270.   BEGIN
  271.     snapshot;
  272.     Write(^G);
  273.     GoToXY(1, 14);
  274.     WriteLn('save and eXit');
  275.     WriteLn('Quit (no save)');
  276.     WriteLn('X,Q');
  277.     Read(Kbd, choice);
  278.     choice := UpCase(choice);
  279.     IF (choice <> 'X') AND (choice <> 'Q') THEN choice := 'Q';
  280.     CASE choice OF
  281.       'X' : BEGIN
  282.               fileit;
  283.               wait := False;
  284.             END;
  285.       'Q' : BEGIN
  286.               wait := False;
  287.             END;
  288.     END;                      {case choice of}
  289.   END;
  290.  
  291.   PROCEDURE Endmartindecision;
  292.   BEGIN
  293.     snapshot;
  294.     Write(^G);
  295.     GoToXY(1, 14);
  296.     WriteLn('save and eXit');
  297.     WriteLn('Quit (no save)');
  298.     WriteLn('X,Q');
  299.     Read(Kbd, choice);
  300.     choice := UpCase(choice);
  301.     IF (choice <> 'X') AND (choice <> 'Q') THEN choice := 'Q';
  302.     CASE choice OF
  303.       'X' : BEGIN
  304.               fileit;
  305.               i := num;
  306.               wait := False;
  307.             END;
  308.       'Q' : BEGIN
  309.               i := num;
  310.               wait := False;
  311.             END;
  312.     END;                      {case choice of}
  313.   END;
  314.  
  315.   PROCEDURE Connettdecision;
  316.   BEGIN
  317.     snapshot;
  318.     Write(^G);
  319.     GoToXY(1, 14);
  320.     WriteLn('Save and continue');
  321.     WriteLn('Continue');
  322.     WriteLn('save and eXit');
  323.     WriteLn('Quit (no save)');
  324.     WriteLn('S,C,X,Q');
  325.     Read(Kbd, choice);
  326.     choice := UpCase(choice);
  327.     IF (choice <> 'S') AND (choice <> 'C') AND (choice <> 'X') AND
  328.     (choice <> 'Q') THEN choice := 'C';
  329.     CASE choice OF
  330.       'S' : BEGIN
  331.               Fileit;
  332.               Project;
  333.             END;
  334.       'C' : Project;
  335.       'X' : BEGIN
  336.               Fileit;
  337.               runc := False;
  338.               TextMode(C80); TextColor(3); WriteLn('Resetting');
  339.               wait := False;
  340.             END;
  341.       'Q' : BEGIN
  342.               runc := False;
  343.               TextMode(C80); TextColor(3); WriteLn('Resetting');
  344.               wait := False;
  345.             END;
  346.     END;                      {case choice of}
  347.   END;
  348.  
  349.   PROCEDURE Martindecision;
  350.   BEGIN
  351.     snapshot;
  352.     Write(^G);
  353.     GoToXY(1, 14);
  354.     WriteLn('Save and continue');
  355.     WriteLn('Continue');
  356.     WriteLn('save and eXit');
  357.     WriteLn('Quit (no save)');
  358.     WriteLn('S,C,X,Q');
  359.     Read(Kbd, choice);
  360.     choice := UpCase(choice);
  361.     IF (choice <> 'S') AND (choice <> 'C') AND (choice <> 'X') AND
  362.     (choice <> 'Q') THEN choice := 'C';
  363.     CASE choice OF
  364.       'S' : BEGIN
  365.               Fileit;
  366.               Project;
  367.             END;
  368.       'C' : Project;
  369.       'X' : BEGIN
  370.               Fileit;
  371.               i := num;
  372.               wait := False;
  373.             END;
  374.       'Q' : BEGIN
  375.               i := num;
  376.               wait := False;
  377.             END;
  378.     END;                      {case choice of}
  379.   END;
  380.  
  381.   PROCEDURE Plotlconnett;
  382.   VAR
  383.     ires, jres : Integer;
  384.   BEGIN
  385.     wait := True;
  386.     runc := True;
  387.     IF highres THEN BEGIN
  388.       ires := 640;
  389.       jres := 200;
  390.       High;
  391.     END ELSE BEGIN
  392.       ires := 320;
  393.       jres := 200;
  394.       Low;
  395.     END;
  396.     IF parms THEN BEGIN
  397.       GoToXY(65, 19); Write('Corna =', corna:5);
  398.       GoToXY(65, 20); Write('Cornb =', cornb:5);
  399.       GoToXY(65, 21); Write('Side  =', side:5);
  400.     END;
  401.     FOR ci := 1 TO ires DO BEGIN
  402.       FOR cj := 1 TO jres DO BEGIN
  403.         IF runc THEN BEGIN
  404.           x := corna+(side*ci/ires);
  405.           y := cornb+(side*cj/jres);
  406.           z := x*x+y*y;
  407.           IF z > 10000 THEN k := Int(z/10000);
  408.           IF z < 10000 THEN k := Int(z);
  409.           cp := Trunc(k);
  410.           cp := cp MOD 4;
  411.           IF KeyPressed THEN Connettdecision;
  412.           CASE cp OF
  413.             0 : Plot(ci, cj, 0);
  414.             1 : Plot(ci, cj, 1);
  415.             2 : Plot(ci, cj, 2);
  416.             3 : Plot(ci, cj, 3);
  417.           END;                {case of cp}
  418.         END;
  419.       END;
  420.     END;
  421.     IF wait THEN IF parms THEN BEGIN
  422.       GoToXY(65, 19); Write('Corna =', corna:5);
  423.       GoToXY(65, 20); Write('Cornb =', cornb:5);
  424.       GoToXY(65, 21); Write('Side  =', side:5);
  425.     END;
  426.     IF wait THEN Endconnettdecision;
  427.   END;
  428.  
  429.   PROCEDURE Plotmartin1;
  430.   VAR
  431.     setting : Integer;
  432.   BEGIN
  433.     IF highres THEN High ELSE Low;
  434.     yp := 0;
  435.     xp := 0;
  436.     x := 0;
  437.     y := 0;
  438.     i := 0;
  439.     IF parms THEN BEGIN
  440.       GoToXY(65, 19); Write('Num =', num:8:0);
  441.       GoToXY(65, 20); Write('A   =', a:5:3);
  442.       GoToXY(65, 21); Write('B   =', b:5:3);
  443.       GoToXY(65, 22); Write('C   =', c:5:3);
  444.     END;
  445.     setting := 1;
  446.     REPEAT
  447.       wait := True;
  448.       i := i+1;
  449.       IF parms THEN BEGIN
  450.         GoToXY(70, 23);
  451.         Write((num-i):8:0);
  452.       END;
  453.       IF highres THEN Plot(xp+320, yp+100, 1) ELSE Plot(xp+160, yp+100, setting);
  454.       IF x > 0 THEN s := 1;
  455.       IF x = 0 THEN s := 0;
  456.       IF x < 0 THEN s := -1;
  457.       xx := y-(s*Sqrt(Abs(b*x-c)));
  458.       yy := (a)-x;
  459.       x := xx;
  460.       y := yy;
  461.       xp := (Trunc(x));
  462.       yp := (Trunc(y));
  463.       IF i > 10000 THEN setter := Trunc(i/10000) ELSE setter := Trunc(i/100);
  464.       IF Odd(setter) THEN setting := 2 ELSE setting := 1;
  465.       IF KeyPressed THEN Martindecision;
  466.     UNTIL i = num;
  467.     IF wait THEN REPEAT UNTIL KeyPressed;
  468.     IF wait THEN Endmartindecision;
  469.   END;
  470.  
  471.   PROCEDURE Connettstartup;
  472.   BEGIN
  473.     ClrScr;
  474.     Setparms;
  475.     Setresolution;
  476.     Setcolor;
  477.     Connetta;
  478.     Connettb;
  479.     Connettside;
  480.   END;
  481.  
  482.   PROCEDURE Martin1startup;
  483.   BEGIN
  484.     ClrScr;
  485.     Setparms;
  486.     Setresolution;
  487.     Setcolor;
  488.     Inmartin1num;
  489.     Inputmartin1a;
  490.     Inputmartin1b;
  491.     Inputmartin1c;
  492.   END;
  493.  
  494.   PROCEDURE Connettmenu;
  495.   BEGIN
  496.     REPEAT
  497.       ClrScr;
  498.       WriteLn;
  499.       WriteLn;
  500.       WriteLn;
  501.       WriteLn(' Press the space bar to begin viewing selection, or ');
  502.       WriteLn;
  503.       WriteLn('Reset corna . . . . . . . . . . . . . . . . . . . . 1');
  504.       WriteLn('Reset cornb . . . . . . . . . . . . . . . . . . . . 2');
  505.       WriteLn('Reset side  . . . . . . . . . . . . . . . . . . . . 3');
  506.       WriteLn('Reset resolution and colors . . . . . . . . . . . . 5');
  507.       WriteLn('Toggle parameter display  . . . . . . . . . . . . . 6');
  508.       WriteLn('Display saved picture . . . . . . . . . . . . . . . 8');
  509.       WriteLn('Reset all values  . . . . . . . . . . . . . . . . . 9');
  510.       WriteLn('Quit  . . . . . . . . . . . . . . . . . . . . . . . 0');
  511.       Read(Kbd, choice);
  512.       CASE choice OF
  513.         '0' : choice := '0';
  514.         '1' : Connetta;
  515.         '2' : Connettb;
  516.         '3' : Connettside;
  517.         '5' : BEGIN
  518.                 Setresolution;
  519.                 Setcolor;
  520.               END;
  521.         '6' : IF NOT(parms) THEN parms := True ELSE parms := False;
  522.         '8' : showit;
  523.         '9' : Connettstartup;
  524.       END;                    {case choice of}
  525.       IF (choice <> '0') AND (choice <> '8') THEN Plotlconnett;
  526.     UNTIL choice = '0';
  527.     choice := 'X';
  528.   END;
  529.  
  530.   PROCEDURE Martin1menu;
  531.   BEGIN
  532.     REPEAT
  533.       ClrScr;
  534.       WriteLn;
  535.       WriteLn;
  536.       WriteLn;
  537.       WriteLn(' Press the space bar to begin viewing selection, or ');
  538.       WriteLn;
  539.       WriteLn('Reset number of iterations  . . . . . . . . . . . . 1');
  540.       WriteLn('Reset a . . . . . . . . . . . . . . . . . . . . . . 2');
  541.       WriteLn('Reset b . . . . . . . . . . . . . . . . . . . . . . 3');
  542.       WriteLn('Reset c . . . . . . . . . . . . . . . . . . . . . . 4');
  543.       WriteLn('Reset resolution and colors . . . . . . . . . . . . 5');
  544.       WriteLn('Toggle parameter display  . . . . . . . . . . . . . 6');
  545.       WriteLn('Display saved picture . . . . . . . . . . . . . . . 8');
  546.       WriteLn('Reset all values  . . . . . . . . . . . . . . . . . 9');
  547.       WriteLn('Quit  . . . . . . . . . . . . . . . . . . . . . . . 0');
  548.       Read(Kbd, choice);
  549.       CASE choice OF
  550.         '0' : choice := '0';
  551.         '1' : Inmartin1num;
  552.         '2' : Inputmartin1a;
  553.         '3' : Inputmartin1b;
  554.         '4' : Inputmartin1c;
  555.         '5' : BEGIN
  556.                 Setresolution;
  557.                 Setcolor;
  558.               END;
  559.         '6' : IF NOT(parms) THEN parms := True ELSE parms := False;
  560.         '8' : showit;
  561.         '9' : Martin1startup
  562.       END;                    {case choice of}
  563.       IF (choice <> '0') AND (choice <> '8') THEN Plotmartin1;
  564.     UNTIL choice = '0';
  565.     choice := 'X';
  566.   END;
  567.  
  568.   PROCEDURE Startscreen;
  569.   BEGIN
  570.     ClrScr;
  571.     TextMode(C80);
  572.     GoToXY(20, 5); TextColor(4);
  573.     Write('WALLPAPER FOR THE MIND');
  574.     GoToXY(1, 7); TextColor(6);
  575.     Write('A display of some of the designs mentioned "Computer Recreations")');
  576.     GoToXY(1, 8);
  577.     Write('by A.K. Dewdney; algorithms from J.E. Connett and B. Martin ');
  578.     GoToXY(1, 9);
  579.     Write('"Scientific American" Vol 255 No. 3; September 1986');
  580.     GoToXY(1, 14); TextColor(3);
  581.     Write('Public Domain -- may be copied and distributed ');
  582.     GoToXY(1, 24); TextColor(3);
  583.     Write('Press any key to continue . . .');
  584.     REPEAT UNTIL KeyPressed;
  585.   END;
  586.  
  587.   PROCEDURE Menu;
  588.   BEGIN
  589.     ClrScr;
  590.     WriteLn('Choose one of the following:');
  591.     WriteLn('Connett''s Algorithm . . . . . . . 1');
  592.     WriteLn('Martin''s Algorithm  . . . . . . . 2');
  593.     WriteLn('Display stored picture  . . . . . 9');
  594.     WriteLn('Quit  . . . . . . . . . . . . . . 0');
  595.     Read(Kbd, choice);
  596.     CASE choice OF
  597.       '1' : BEGIN
  598.               Connettstartup;
  599.               Connettmenu;
  600.             END;
  601.       '2' : BEGIN
  602.               Martin1startup;
  603.               Martin1menu;
  604.             END;
  605.       '9' : showit;
  606.       '0' : choice := '0';
  607.     END;                      {case choice of}
  608.   END;
  609.  
  610. BEGIN                         {main program starts here}
  611.   showfilename := '';
  612.   savefilename := '';
  613.   FOR cz := 1 TO 17000 DO BEGIN
  614.     picture[cz] := Chr(0);
  615.     picturesave[cz] := Chr(0);
  616.     pictureshow[cz] := Chr(0);
  617.   END;
  618.   choice := '0';
  619.   Startscreen;
  620.   REPEAT
  621.     Menu;
  622.   UNTIL choice = '0';
  623.   TextMode(C80);
  624. END.
  625.